indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 387)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.04999 13.04526 13.04060 13.03600 13.03146 13.02697 13.02255 13.01818
## [9] 13.01387 13.00961 13.00541 13.00126 12.99716 12.99312 12.98912 12.98517
## [17] 12.98127 12.97742 12.97361 12.96985 12.96613 12.96245 12.95882 12.95523
## [25] 12.95168 12.94816 12.94469 12.94125 12.93785 12.93448 12.93114 12.92784
## [33] 12.92457 12.92133 12.91813 12.91495 12.91180 12.90871 12.90566 12.90267
## [41] 12.89972 12.89682 12.89397 12.89118 12.88843 12.88574 12.88310 12.88052
## [49] 12.87798 12.87551 12.87308 12.87072 12.86840 12.86615 12.86395 12.86181
## [57] 12.85973 12.85770 12.85574 12.85384 12.85199 12.85021 12.84849 12.84683
## [65] 12.84523 12.84370 12.84223 12.84082 12.83948 12.83820 12.83699 12.83585
## [73] 12.83477 12.83377 12.83282 12.83195 12.83115 12.83041 12.82974 12.82911
## [81] 12.82853 12.82799 12.82750 12.82706 12.82666 12.82631 12.82602 12.82577
## [89] 12.82557 12.82542 12.82532 12.82527 12.82527 12.82532 12.82543 12.82558
## [97] 12.82579 12.82605 12.82637 12.82674 12.82716 12.82764 12.82818 12.82876
## [105] 12.82941 12.83011 12.83087 12.83168 12.83255 12.83348 12.83447 12.83552
## [113] 12.83662 12.83778 12.83901 12.84029 12.84164 12.84304 12.84451 12.84604
## [121] 12.84790 12.85033 12.85326 12.85666 12.86047 12.86463 12.86910 12.87382
## [129] 12.87874 12.88381 12.88897 12.89418 12.89938 12.90453 12.90956 12.91442
## [137] 12.91907 12.92345 12.92751 12.93120 12.93446 12.93725 12.94085 12.94645
## [145] 12.95384 12.96281 12.97316 12.98468 12.99716 13.01038 13.02415 13.03825
## [153] 13.05247 13.06661 13.08046 13.09381 13.10645 13.11817 13.12877 13.13803
## [161] 13.14575 13.15172 13.15573 13.15932 13.16410 13.16995 13.17674 13.18437
## [169] 13.19272 13.20166 13.21109 13.22088 13.23092 13.24108 13.25126 13.26133
## [177] 13.27119 13.28070 13.28975 13.29823 13.30602 13.31300 13.31906 13.32407
## [185] 13.32792 13.33049 13.33167 13.33134 13.32937 13.32615 13.32213 13.31737
## [193] 13.31189 13.30575 13.29899 13.29164 13.28375 13.27536 13.26651 13.25724
## [201] 13.24759 13.23760 13.22732 13.21678 13.20603 13.19511 13.18406 13.17291
## [209] 13.16172 13.15053 13.13936 13.12827 13.11564 13.10005 13.08179 13.06121
## [217] 13.03862 13.01432 12.98866 12.96193 12.93447 12.90659 12.87861 12.85085
## [225] 12.82363 12.79726 12.77207 12.74837 12.72649 12.70673 12.68943 12.67242
## [233] 12.65347 12.63277 12.61054 12.58698 12.56229 12.53668 12.51035 12.48350
## [241] 12.45635 12.42909 12.40193 12.37508 12.34874 12.32311 12.29840 12.27481
## [249] 12.25256 12.23183 12.21284 12.19579 12.18013 12.16511 12.15068 12.13676
## [257] 12.12329 12.11020 12.09742 12.08489 12.07255 12.06032 12.04813 12.03593
## [265] 12.02364 12.01120 11.99855 11.98560 11.97335 11.96270 11.95352 11.94565
## [273] 11.93893 11.93323 11.92839 11.92426 11.92070 11.91755 11.91466 11.91188
## [281] 11.90906 11.90606 11.90273 11.89890 11.89444 11.88920 11.88302 11.87576
## [289] 11.86726 11.85780 11.84780 11.83735 11.82651 11.81537 11.80400 11.79248
## [297] 11.78088 11.76928 11.75775 11.74639 11.73525 11.72442 11.71398 11.70399
## [305] 11.69455 11.68571 11.67757 11.67020 11.66303 11.65551 11.64769 11.63963
## [313] 11.63139 11.62303 11.61462 11.60621 11.59786 11.58964 11.58160 11.57380
## [321] 11.56630 11.55917 11.55247 11.54625 11.54057 11.53550 11.53110 11.52742
## [329] 11.52452 11.52205 11.51963 11.51727 11.51501 11.51287 11.51089 11.50908
## [337] 11.50748 11.50611 11.50500 11.50418 11.50367 11.50350 11.50370 11.50429
## [345] 11.50531 11.50664 11.50817 11.50989 11.51182 11.51396 11.51632 11.51891
## [353] 11.52172 11.52478 11.52808 11.53163 11.53544 11.53952 11.54387 11.54849
## [361] 11.55340 11.55859 11.56409 11.56989 11.57600 11.58242 11.58922 11.59644
## [369] 11.60408 11.61211 11.62054 11.62933 11.63849 11.64800 11.65784 11.66801
## [377] 11.67849 11.68927 11.70034 11.71169 11.72329 11.73515 11.74725 11.75957
## [385] 11.77211 11.78484 11.79777#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 387)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.58893 12.58571 12.58256 12.57948 12.57646 12.57350 12.57061 12.56779
## [9] 12.56503 12.56234 12.55972 12.55717 12.55468 12.55226 12.54992 12.54764
## [17] 12.54544 12.54330 12.54124 12.53925 12.53733 12.53548 12.53371 12.53201
## [25] 12.53038 12.52883 12.52736 12.52596 12.52464 12.52339 12.52222 12.52113
## [33] 12.52012 12.51918 12.51833 12.51755 12.51685 12.51623 12.51570 12.51524
## [41] 12.51486 12.51456 12.51433 12.51419 12.51412 12.51413 12.51421 12.51437
## [49] 12.51460 12.51491 12.51530 12.51576 12.51629 12.51690 12.51758 12.51833
## [57] 12.51915 12.52005 12.52102 12.52206 12.52317 12.52435 12.52560 12.52692
## [65] 12.52831 12.52977 12.53130 12.53290 12.53456 12.53629 12.53809 12.53995
## [73] 12.54188 12.54388 12.54594 12.54807 12.55026 12.55251 12.55491 12.55754
## [81] 12.56037 12.56341 12.56665 12.57007 12.57368 12.57746 12.58140 12.58550
## [89] 12.58974 12.59413 12.59865 12.60330 12.60806 12.61292 12.61789 12.62295
## [97] 12.62809 12.63331 12.63860 12.64394 12.64934 12.65478 12.66025 12.66576
## [105] 12.67128 12.67681 12.68235 12.68788 12.69339 12.69889 12.70435 12.70978
## [113] 12.71516 12.72049 12.72576 12.73096 12.73608 12.74111 12.74605 12.75089
## [121] 12.75602 12.76182 12.76820 12.77508 12.78240 12.79007 12.79803 12.80619
## [129] 12.81449 12.82284 12.83118 12.83942 12.84750 12.85533 12.86285 12.86997
## [137] 12.87663 12.88274 12.88824 12.89304 12.89826 12.90493 12.91291 12.92203
## [145] 12.93213 12.94306 12.95466 12.96676 12.97921 12.99185 13.00452 13.01706
## [153] 13.02931 13.04112 13.05232 13.06275 13.07226 13.08069 13.08787 13.09366
## [161] 13.09788 13.10240 13.10901 13.11746 13.12753 13.13897 13.15154 13.16500
## [169] 13.17912 13.19366 13.20837 13.22301 13.23736 13.25116 13.26418 13.27618
## [177] 13.28691 13.29616 13.30366 13.30918 13.31249 13.31335 13.31219 13.30970
## [185] 13.30594 13.30099 13.29492 13.28781 13.27973 13.27076 13.26097 13.25044
## [193] 13.23925 13.22746 13.21516 13.20242 13.18931 13.17591 13.16229 13.14853
## [201] 13.13471 13.12090 13.10717 13.09360 13.08027 13.06724 13.05461 13.04243
## [209] 13.03079 13.01975 13.00696 12.99034 12.97040 12.94765 12.92262 12.89581
## [217] 12.86775 12.83895 12.80993 12.78120 12.75327 12.72666 12.70189 12.67948
## [225] 12.65993 12.64377 12.62859 12.61177 12.59349 12.57392 12.55326 12.53168
## [233] 12.50935 12.48647 12.46320 12.43974 12.41625 12.39292 12.36993 12.34746
## [241] 12.32569 12.30479 12.28496 12.26636 12.24919 12.23361 12.21981 12.20757
## [249] 12.19648 12.18644 12.17734 12.16908 12.16157 12.15469 12.14835 12.14245
## [257] 12.13687 12.13153 12.12631 12.12112 12.11586 12.11041 12.10468 12.09858
## [265] 12.09198 12.08480 12.07693 12.06827 12.06011 12.05370 12.04887 12.04545
## [273] 12.04327 12.04214 12.04190 12.04237 12.04339 12.04477 12.04635 12.04795
## [281] 12.04940 12.05052 12.05114 12.05110 12.05021 12.04830 12.04521 12.04075
## [289] 12.03475 12.02765 12.02001 12.01191 12.00341 11.99457 11.98546 11.97615
## [297] 11.96670 11.95717 11.94763 11.93815 11.92878 11.91960 11.91067 11.90205
## [305] 11.89380 11.88601 11.87871 11.87200 11.86543 11.85859 11.85150 11.84421
## [313] 11.83674 11.82914 11.82144 11.81368 11.80590 11.79812 11.79039 11.78274
## [321] 11.77522 11.76785 11.76067 11.75372 11.74704 11.74065 11.73461 11.72894
## [329] 11.72368 11.71861 11.71349 11.70834 11.70317 11.69800 11.69286 11.68776
## [337] 11.68272 11.67775 11.67288 11.66812 11.66349 11.65901 11.65470 11.65057
## [345] 11.64664 11.64285 11.63909 11.63539 11.63174 11.62815 11.62463 11.62117
## [353] 11.61780 11.61451 11.61130 11.60819 11.60518 11.60227 11.59947 11.59679
## [361] 11.59423 11.59180 11.58950 11.58734 11.58533 11.58346 11.58180 11.58039
## [369] 11.57922 11.57828 11.57755 11.57703 11.57670 11.57656 11.57658 11.57677
## [377] 11.57710 11.57756 11.57816 11.57886 11.57967 11.58057 11.58154 11.58258
## [385] 11.58368 11.58482 11.58600#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 387)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.05158 12.04491 12.03833 12.03187 12.02550 12.01924 12.01308 12.00702
## [9] 12.00106 11.99520 11.98944 11.98377 11.97820 11.97273 11.96735 11.96206
## [17] 11.95687 11.95177 11.94676 11.94184 11.93701 11.93227 11.92762 11.92305
## [25] 11.91857 11.91418 11.90987 11.90564 11.90150 11.89743 11.89345 11.88955
## [33] 11.88573 11.88198 11.87831 11.87472 11.87121 11.86777 11.86440 11.86111
## [41] 11.85788 11.85473 11.85165 11.84867 11.84581 11.84307 11.84045 11.83794
## [49] 11.83556 11.83329 11.83114 11.82910 11.82718 11.82536 11.82367 11.82208
## [57] 11.82060 11.81923 11.81797 11.81681 11.81576 11.81482 11.81398 11.81324
## [65] 11.81261 11.81207 11.81164 11.81131 11.81107 11.81093 11.81089 11.81094
## [73] 11.81108 11.81132 11.81166 11.81208 11.81259 11.81319 11.81388 11.81466
## [81] 11.81553 11.81648 11.81751 11.81863 11.81983 11.82107 11.82232 11.82358
## [89] 11.82485 11.82615 11.82747 11.82883 11.83022 11.83165 11.83314 11.83468
## [97] 11.83627 11.83793 11.83967 11.84147 11.84336 11.84533 11.84739 11.84955
## [105] 11.85181 11.85418 11.85666 11.85926 11.86198 11.86483 11.86782 11.87094
## [113] 11.87421 11.87762 11.88120 11.88493 11.88883 11.89290 11.89714 11.90157
## [121] 11.90618 11.91099 11.91600 11.92121 11.92662 11.93225 11.93894 11.94736
## [129] 11.95729 11.96850 11.98078 11.99389 12.00761 12.02172 12.03599 12.05020
## [137] 12.06411 12.07751 12.09017 12.10186 12.11237 12.12146 12.13149 12.14476
## [145] 12.16092 12.17965 12.20061 12.22347 12.24789 12.27356 12.30012 12.32725
## [153] 12.35462 12.38189 12.40873 12.43481 12.45980 12.48335 12.50515 12.52485
## [161] 12.54213 12.55665 12.56807 12.57878 12.59127 12.60535 12.62084 12.63757
## [169] 12.65536 12.67404 12.69342 12.71333 12.73359 12.75402 12.77445 12.79470
## [177] 12.81459 12.83394 12.85258 12.87033 12.88701 12.90245 12.91646 12.92887
## [185] 12.93950 12.94818 12.95472 12.95896 12.96070 12.95993 12.95684 12.95159
## [193] 12.94438 12.93536 12.92470 12.91259 12.89918 12.88466 12.86920 12.85296
## [201] 12.83613 12.81886 12.80134 12.78373 12.76620 12.74894 12.73211 12.71588
## [209] 12.70042 12.68591 12.67252 12.66042 12.64708 12.63012 12.60994 12.58694
## [217] 12.56154 12.53412 12.50510 12.47488 12.44385 12.41243 12.38100 12.34999
## [225] 12.31978 12.29079 12.26341 12.23804 12.21510 12.19498 12.17808 12.16226
## [233] 12.14518 12.12699 12.10780 12.08776 12.06701 12.04566 12.02386 12.00174
## [241] 11.97943 11.95706 11.93478 11.91270 11.89097 11.86972 11.84908 11.82918
## [249] 11.81016 11.79215 11.77528 11.75969 11.74527 11.73174 11.71900 11.70694
## [257] 11.69544 11.68441 11.67374 11.66331 11.65302 11.64276 11.63242 11.62190
## [265] 11.61108 11.59987 11.58814 11.57580 11.56359 11.55227 11.54178 11.53205
## [273] 11.52299 11.51454 11.50663 11.49918 11.49212 11.48538 11.47888 11.47256
## [281] 11.46634 11.46015 11.45391 11.44756 11.44101 11.43421 11.42707 11.41952
## [289] 11.41150 11.40305 11.39433 11.38539 11.37629 11.36707 11.35779 11.34852
## [297] 11.33929 11.33017 11.32122 11.31247 11.30400 11.29586 11.28809 11.28076
## [305] 11.27392 11.26762 11.26191 11.25686 11.25201 11.24687 11.24153 11.23601
## [313] 11.23039 11.22471 11.21902 11.21338 11.20785 11.20248 11.19731 11.19241
## [321] 11.18783 11.18362 11.17984 11.17654 11.17377 11.17158 11.17004 11.16919
## [329] 11.16909 11.16936 11.16961 11.16989 11.17024 11.17070 11.17130 11.17208
## [337] 11.17309 11.17437 11.17595 11.17787 11.18017 11.18290 11.18610 11.18979
## [345] 11.19403 11.19865 11.20349 11.20854 11.21381 11.21933 11.22509 11.23111
## [353] 11.23740 11.24396 11.25081 11.25795 11.26539 11.27316 11.28124 11.28966
## [361] 11.29842 11.30753 11.31701 11.32686 11.33708 11.34770 11.35878 11.37037
## [369] 11.38245 11.39501 11.40803 11.42149 11.43539 11.44970 11.46440 11.47949
## [377] 11.49495 11.51076 11.52691 11.54337 11.56014 11.57719 11.59452 11.61211
## [385] 11.62994 11.64799 11.66625#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")